{-# OPTIONS -Wall #-}


module Demo01 where

import Wumpus.FontPic.Datatypes
import Wumpus.FontPic.Parser


import Wumpus.Drawing.Dots.SimpleDots           -- package: wumpus-drawing
import Wumpus.Drawing.Paths          
import Wumpus.Drawing.Text.Base.Label
import Wumpus.Drawing.Text.DirectionZero
import Wumpus.Drawing.Text.StandardFontDefs

import Wumpus.Basic.Kernel                      -- package: wumpus-basic
import Wumpus.Basic.System.FontLoader

import Wumpus.Core                              -- package: wumpus-core


import qualified Data.Map as M
import System.Directory
import Prelude hiding ( lines )

main :: IO ()
main = simpleFontLoader main1 >> return ()

main1 :: FontLoader -> IO ()
main1 loader = do
    createDirectoryIfMissing True "./out/"
    base_metrics <- loader [ Left helvetica ]
    Right fs <- parseFaceSpec "../../c/arial.props" 
    let pic1 = runCtxPictureU (makeCtx base_metrics) (illustrateChar fs 'S')
    writeEPS "./out/char_path.eps" pic1
    writeSVG "./out/char_path.svg" pic1 

makeCtx :: FontLoadResult -> DrawingContext
makeCtx = set_font helvetica . metricsContext 16

illustrateChar :: FaceSpec -> Char -> CtxPicture
illustrateChar fs ch = 
    drawTracing $ maybe fk drawOutlines $ M.lookup ch (char_outlines fs)
  where
    fk = drawl zeroPt $ textline CENTER "lookup failed"



drawOutlines :: [Outline] -> TraceDrawing Double ()
drawOutlines = mapM_ fn
  where
    mkPt x y        = P2 (fromIntegral x) (fromIntegral y)

    fn (Moveto x y)                 = drawl (mkPt x y) $ smallDisk    
    fn (Lineto x y)                 = drawl (mkPt x y) $ smallDisk
    fn (Conicto x1 y1 x2 y2)        = do 
      drawl (mkPt x1 y1) $ smallDisk
      drawl (mkPt x2 y2) $ smallDisk
    fn (Curveto x1 y1 x2 y2 x3 y3)  = do
      drawl (mkPt x1 y1) $ smallDisk
      drawl (mkPt x2 y2) $ smallDisk
      drawl (mkPt x3 y3) $ smallDisk
